COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00008 ENDMK
C⊗;

TITLE PLTF80 -- FORTRAN PLOT ROUTINES FOR FR-80 OUTPUT

COMMENT ⊗

	APLOT(X,Y,UPDOWN) ←
		 IF ABS(UPDOWN)=2 THEN AVECT(X+FR80X0,Y+FR80Y0)
		 ELSE IF ABS(UPDOWN)=3 THEN AIVECT(X+FR80X0,Y+FR80Y0);
		 IF UPDOWN<0 THEN <FR80X0←X;FR80Y0←Y;>
	OUTCMD(CMD)  puts out one command on channel 17.
	OUTCML(CMDL) does outcmd on successive words starting at
		    CMDL until a negative word is seen.
	INFR80(DEV,FID,EXT) initializes FR80 output on the named file
		on channel 17.  
	RLFR80 releases channel 17.
	CMD ← FR80EC(<bits 3-8>,<bits 9-17>);  (bits 0:2 get set to 2)
	CMD ← FR80CD(<bits 4-6>,<bits 7-17>);  checkpoint delimiter format
⊗
INTERNAL APLOT,OUTCMD,OUTCML,INFR80,RLFR80,FR80EC,FR80CD,FR80X0,FR80Y0
	
ARG← 16

CMD ← 0
A ← 1
B ← 2
C ← 3

XC ←← 0	;X COORD
YC ←← 1 ;Y COORD
UPDOWN ←← 2;


APLOT:	0		;BECAUSE OF BLECHEROUS FORTRAN CALL
	MOVE	CMD,@XC(ARG)
	ADD	CMD,FR80X0 	;ADD OFFSET
	SKIPGE	@UPDOWN(ARG)	;CORRECTING OFFSET?
	MOVEM	CMD,FR80X0	;YES
	ANDI	CMD,37777 	;TRUNCATE IT
	MOVM	A,@UPDOWN(ARG)	;
	CAIE	A,2		;ERROR CHECK
	CAIN	A,3		;
	SKIPA
	OUTSTR	[ASCIZ / ILLEGAL VALUE FOR UPDOWN IN CALL TO APLOT.
INVISIBLE VECTOR DRAWN/]
	CAIN	A,2		;IF NOT A 2, THEN INVIS
	TROA	CMD,400000	;AN AVECT X-PART
	TRO	CMD,100000	;AN AIVECT X-PART
	JSA	ARG,OUTCMD	;PUT IT OUT
	JUMP	CMD
	MOVE	CMD,@YC(ARG)	;
	ADD	CMD,FR80Y0	;
	SKIPGE	CMD,@UPDOWN(ARG)
	MOVEM	CMD,FR80Y0	;UPDATE
	ANDI	CMD,37777	;
	TRO	CMD,40000	;SAY THE Y BIT IS ON
	JSA	ARG,OUTCMD	;PUT IT OUT
	JUMP	CMD
	JRA	ARG,3(ARG)	;RETURN

OP ←← 0
VAL ←← 1

FR80EC:	LDB	CMD,[POINT 6,@OP(ARG),=35]	;OP PART
	LSH	CMD,=9
	LDB	A,[POINT =9,@VAL(ARG),=35]	;VAL PART
	TRO	CMD,200000(A)	;
	JRA	ARG,2(ARG)	;RETURN

FR80CD:	LDB	CMD,[POINT 3,@OP(ARG),=35]
	LSH	CMD,=11
	MOVE	A,@VAL(ARG)
	DPB	A,[POINT =11,CMD,35]
	JRA	ARG,2(ARG)

OUTCML:	0			;PUTS OUT A WHOLE LIST (-1) TERMINATES
	MOVEI	A,@(ARG)	;PICK UP POINTER TO LIST
OCML.X:	SKIPGE	(A)		;IS IT VALID
	JRA	ARG,1(ARG)	;NO--RETURN
	JSA	ARG,OUTCMD	;
	JUMP	(A)		;A POINTS AT A GOOD ONE
	AOJA	A,OCML.X	;GO BACK

OUTCMD:	0			;FORTRAN CALL FOR ONE CMD
	MOVE	CMD,@(ARG)
OUT.XX:	SOSGE	FR80BH+2		;ANY LEFT IN THIS BUFFER??
	JRST	.+3
	IDPB	CMD,FR80BH+1	;
	JRA	ARG,1(ARG)	;RETURN
	OUT	17,
	JRST	OUT.XX		;NOW PUT THINGS OUT
	OUTSTR	[ASCIZ /OUTPUT ERROR ON CHANNEL 17 (FR80)/]
	HALT	1(ARG)

DEV ←← 0			;SIXBIT DEVICE
FID ←← 1			;SIXBIT FILEID
EXT ←← 2


INFR80: 0
	SKIPN	A,@DEV(ARG)
	MOVSI	A,'DSK'
	MOVEM	A,FR80DV
	OPEN	17,FR80BK
	JRST	[ OUTSTR [ASCIZ /OPEN FAILED FOR FR80 OUTPUT (CHANNEL 17)/]
	         HALT	3(ARG)]	;RETURN
	OUTBUF	17,6		;GET SOME BUFFERS
	MOVEI	A,(<POINT =18,0>)
	HRLM	A,FR80BH+1	;MUNCH BYTE COUNT
	SKIPN	A,@FID(ARG)
	MOVE	A,[SIXBIT /FR80/]
	MOVEM	A,FR80FI
	SKIPN	A,@EXT(ARG)
	MOVSI	A,'F80'
	MOVEM	A,FR80EX
	ENTER	17,FR80FI	;ENTER
	JRST	[ OUTSTR [ASCIZ /ENTER FAILED ON FR80 OUTPUT FILE/]
		HALT	3(ARG)]	;JUST RETURN
	MOVEI	CMD,20000	; 2↑13 = 2↑14/2 = CENTER OF SCREEN
	MOVEM	CMD,FR80X0
	SETZM	FR80Y0
	JRA	ARG,3(ARG)	;RETURN 

RLFR80:	0
	RELEASE	17,
	JRA	ARG,(ARG)

FR80X0:	0		;X & Y OFFSETS
FR80Y0:	0

FR80BH:	0	;BUFFER HEADER
	0
	0

FR80FI:	0	;LOOKUP BLOCK
FR80EX:	0
	0
	0

FR80BK:	0	;OPEN BLOCK
FR80DV:	0
	XWD FR80BH,0
END